home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SAMPLES / SMOOTH.S < prev    next >
Encoding:
Text File  |  1993-02-07  |  1.0 KB  |  46 lines
  1. (define r1 '(-.0625 .5625 .5625 -.0625))
  2. (define r2 '(-.18 .68 .68 -.18))
  3. (define r3 '(.3 .1 .4 .2))
  4. (define r4 '(.1 .4 .4 .1))
  5.  
  6. (define (f rule l)
  7.   (apply + (map *
  8.         rule
  9.         (list (if (null? l) 0 (car l))
  10.               (if (null? (cdr l)) 0 (cadr l))
  11.               (if (null? (cddr l)) 0 (caddr l))
  12.               (if (null? (cdddr l)) 0 (cadddr l))))))
  13. (define N0 (list 0 0 0 1 0 0))
  14. (define (next rule l)
  15.   (define (loop l)
  16.     (if (null? (cdr l))
  17.     '()
  18.     (cons (cadr l)
  19.           (cons (f rule l)
  20.             (loop (cdr l))))))
  21.   (loop (cons 0 l)))
  22.  
  23. (define (plot y)
  24.   (define (make-x from by num)
  25.     (if (= num 0)
  26.     '()
  27.     (cons from (make-x (+ from by) by (- num 1)))))
  28.   (let ((x (make-x -3 (/ 6 (length y)) (length y))))
  29.     (move-to (cons (car x) (car y)))
  30.     (map (lambda (x y) (line-to (cons x y))) x y))
  31.   (line-to '(3 . 0)))
  32.  
  33. (define (ig)
  34.   (init-graph)
  35.   (set-world! '(0 . 1) '(1 . 2))
  36.   (set-world! '(-3 . 1) '(3 . -.5)))
  37.  
  38. (define (cg)
  39.   (close-graph))
  40.  
  41. (define (iter rule n)
  42.   (if (= n 0)
  43.       n0
  44.       (next rule (iter rule (- n 1)))))
  45.  
  46.